home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xt / class.c < prev    next >
C/C++ Source or Header  |  1992-11-03  |  6KB  |  218 lines
  1. #include "xt.h"
  2.  
  3. #define MAX_CLASS            128
  4. #define MAX_CALLBACK_PER_CLASS   10
  5.  
  6. typedef struct {
  7.     char *name;
  8.     int has_arg;
  9. } CALLBACK_INFO;
  10.  
  11. typedef struct {
  12.     WidgetClass class;
  13.     char *name;
  14.     CALLBACK_INFO cb[MAX_CALLBACK_PER_CLASS], *cblast;
  15.     XtResourceList sub_resources;
  16.     int num_resources;
  17. } CLASS_INFO;
  18.  
  19. static CLASS_INFO ctab[MAX_CLASS], *clast = ctab;
  20.  
  21. Generic_Predicate (Class)
  22.  
  23. Generic_Simple_Equal (Class, CLASS, class)
  24.  
  25. Generic_Print (Class, "#[class %s]", CLASS(x)->name)
  26.  
  27. Object Make_Class (class, name) WidgetClass class; char *name; {
  28.     Object c;
  29.  
  30.     c = Find_Object (T_Class, (GENERIC)0, Match_Xt_Obj, class);
  31.     if (Nullp (c)) {
  32.     c = Alloc_Object (sizeof (struct S_Class), T_Class, 0);
  33.     CLASS(c)->tag = Null;
  34.     CLASS(c)->class = class;
  35.     CLASS(c)->name = name;
  36.     Register_Object (c, (GENERIC)0, (PFO)0, 0);
  37.     /* See comment in Define_Class below */
  38.     XtInitializeWidgetClass (class);
  39.     }
  40.     return c;
  41. }
  42.  
  43. Object Make_Widget_Class (class) WidgetClass class; {
  44.     register CLASS_INFO *p;
  45.  
  46.     for (p = ctab; p < clast; p++)
  47.     if (p->class == class)
  48.         return Make_Class (class, p->name);
  49.     Primitive_Error ("undefined widget class");
  50.     /*NOTREACHED*/
  51. }
  52.  
  53. static Object P_Find_Class (name) Object name; {
  54.     register char *s;
  55.     register CLASS_INFO *p;
  56.     Declare_C_Strings;
  57.  
  58.     Make_C_String (name, s);
  59.     for (p = ctab; p < clast; p++) {
  60.     if (streq (p->name, s)) {
  61.         Dispose_C_Strings;
  62.         return Make_Class (p->class, p->name);
  63.     }
  64.     }
  65.     Primitive_Error ("no such widget class: ~s", name);
  66.     /*NOTREACHED*/
  67. }
  68.  
  69. static Object P_Class_Existsp (name) Object name; {
  70.     register char *s;
  71.     register CLASS_INFO *p;
  72.     Declare_C_Strings;
  73.  
  74.     Make_C_String (name, s);
  75.     for (p = ctab; p < clast; p++) {
  76.     if (streq (p->name, s)) {
  77.         Dispose_C_Strings;
  78.         return True;
  79.     }
  80.     }
  81.     Dispose_C_Strings;
  82.     return False;
  83. }
  84.  
  85. char *Class_Name (class) WidgetClass class; {
  86.     register CLASS_INFO *p;
  87.  
  88.     for (p = ctab; p < clast && p->class != class; p++)
  89.     ;
  90.     if (p == clast)
  91.     return "unknown";
  92.     return p->name;
  93. }
  94.  
  95. void Get_Sub_Resource_List (class, rp, np) WidgetClass class;
  96.     XtResourceList *rp; Cardinal *np; {
  97.     register CLASS_INFO *p;
  98.  
  99.     for (p = ctab; p < clast && p->class != class; p++)
  100.     ;
  101.     if (p == clast)
  102.     Panic ("Get_Sub_Resource_List");
  103.     *np = p->num_resources;
  104.     *rp = p->sub_resources;
  105. }
  106.  
  107. static Object P_Class_Resources (c) Object c; {
  108.     Check_Type (c, T_Class);
  109.     return Get_Resources (CLASS(c)->class, XtGetResourceList, 1);
  110. }
  111.  
  112. static Object P_Class_Constraint_Resources (c) Object c; {
  113.     Check_Type (c, T_Class);
  114.     return Get_Resources (CLASS(c)->class, XtGetConstraintResourceList, 1);
  115. }
  116.  
  117. static Object P_Class_Sub_Resources (c) Object c; {
  118.     Check_Type (c, T_Class);
  119.     return Get_Resources (CLASS(c)->class, Get_Sub_Resource_List, 0);
  120. }
  121.  
  122. void Define_Class (name, class, r, nr) char *name; WidgetClass class;
  123.     XtResourceList r; {
  124.     Error_Tag = "define-class";
  125.     if (clast == ctab+MAX_CLASS)
  126.     Primitive_Error ("too many widget classes");
  127.     /*
  128.      * The next line should read:
  129.      *    XtInitializeWidgetClass (class);
  130.      * However, there is a bug in Motif 1.1.4 that causes an application
  131.      * to drop core if the row-column widget class is initialized before
  132.      * the first vendor-shell widget has been created.
  133.      * Thus, we can't initialize any classes at this point; we will do
  134.      * it in Make_Class above instead.
  135.      * This essentially causes a class to be initialized the first time
  136.      * it is used.
  137.      */
  138.     clast->name = name;
  139.     clast->class = class;
  140.     clast->cb[0].name = XtNdestroyCallback;
  141.     clast->cb[0].has_arg = 0;
  142.     clast->cblast = clast->cb+1;
  143.     clast->sub_resources = r;
  144.     clast->num_resources = nr;
  145.     clast++;
  146. }
  147.  
  148. void Define_Callback (cl, s, has_arg) char *cl, *s; {
  149.     register CLASS_INFO *p;
  150.  
  151.     Error_Tag = "define-callback";
  152.     for (p = ctab; p < clast; p++)
  153.     if (streq (p->name, cl)) {
  154.         if (p->cblast == p->cb+MAX_CALLBACK_PER_CLASS)
  155.         Primitive_Error ("too many callbacks for this class");
  156.         p->cblast->name = s;
  157.         p->cblast->has_arg = has_arg;
  158.         p->cblast++;
  159.         return;
  160.     }
  161.     Primitive_Error ("undefined class");
  162. }
  163.  
  164. PFX2S Find_Callback_Converter (c, name, sname) WidgetClass c; char *name;
  165.     Object sname; {
  166.     register CLASS_INFO *p;
  167.     register CALLBACK_INFO *q;
  168.     PFX2S conv;
  169.  
  170.     for (p = ctab; p < clast; p++)
  171.     if (p->class == c) {
  172.         for (q = p->cb; q < p->cblast; q++)
  173.         if (streq (q->name, name)) {
  174.             if (q->has_arg) {
  175.             char s[128], msg[256];
  176.  
  177.             /* First look for a class specific converter
  178.              * then for a general one:
  179.              */
  180.             sprintf (s, "%s-%s", p->name, name);
  181.             conv = Find_Converter_To_Scheme (s);
  182.             if (conv == 0) {
  183.                 conv = Find_Converter_To_Scheme (name);
  184.                 if (conv == 0) {
  185.                 sprintf (msg,
  186.                     "no callback converter for %s or %s",
  187.                     s, name);
  188.                 Primitive_Error (msg);
  189.                 }
  190.             }
  191.             return conv;
  192.             } else return (PFX2S)0;
  193.         }
  194.         Primitive_Error ("no such callback: ~s", sname);
  195.     }
  196.     Panic ("Find_Callback_Converter");
  197.     /*NOTREACHED*/
  198. }
  199.  
  200. init_xt_class () {
  201.     Generic_Define (Class, "class", "class?");
  202.     Define_Primitive (P_Find_Class,        "find-class",        1, 1, EVAL);
  203.     Define_Primitive (P_Class_Resources,   "class-resources",   1, 1, EVAL);
  204.     Define_Primitive (P_Class_Constraint_Resources, 
  205.                                "class-constraint-resources",    1, 1, EVAL);
  206.     Define_Primitive (P_Class_Sub_Resources,
  207.                    "class-sub-resources",           1, 1, EVAL);
  208.     Define_Primitive (P_Class_Existsp,     "class-exists?",     1, 1, EVAL);
  209.     /*
  210.      * Doesn't work with Motif-1.1.0:
  211.      *
  212.     Define_Class ("simple", simpleWidgetClass, (XtResourceList)0, 0);
  213.      */
  214.     Define_Class ("core", widgetClass, (XtResourceList)0, 0);
  215.     Define_Class ("constraint", constraintWidgetClass, (XtResourceList)0, 0);
  216.     Define_Class ("composite", compositeWidgetClass, (XtResourceList)0, 0);
  217. }
  218.